home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Internet Tools 1993 July / Internet Tools.iso / RockRidge / info-service / gopher / Rice_CMS / gopher24 / gopclifv.rexx < prev    next >
Encoding:
OS/2 REXX Batch file  |  1993-01-21  |  17.5 KB  |  577 lines
  1. /*
  2.  *        Name: GOPCLIFV REXX
  3.  *              VM TCP/IP Network GOPHER Client file viewer
  4.  *      Author: Rick Troth, Rice University, Information Systems
  5.  *        Date: 1992-Dec-23
  6.  *
  7.  *       Input: a plain-text file to view
  8.  *      Output: zero or more information or error messages
  9.  */
  10.  
  11. /*
  12.  *      Copyright 1992 Richard M. Troth.   This software was developed
  13.  *      with resources provided by Rice University and is intended
  14.  *      to serve Rice's user community.   Rice has benefitted greatly
  15.  *      from the free distribution of software,  therefore distribution
  16.  *      of unmodified copies of this material is not restricted.
  17.  *      You may change your own copy as needed.   Neither Rice
  18.  *      University nor any of its employees or students shall be held
  19.  *      liable for damages resulting from the use of this software.
  20.  */
  21.  
  22. Trace "OFF"
  23.  
  24. Parse Arg args '(' . ')' .
  25.  
  26. /*  verify availability of input  */
  27. 'PEEKTO'
  28. If rc ^= 0 & rc ^= 12 Then Exit rc
  29. If rc = 12 Then Do  /*  Warning: file is empty  */
  30.     'CALLPIPE COMMAND XMITMSG 559 (ERRMSG | *:'
  31.     Exit
  32.     End  /*  If  ..  Do  */
  33.  
  34. Address "COMMAND" 'GLOBALV SELECT GOPHER GET' ,
  35.         'GOPHER PROGID VIEWER ITEM'
  36. quit = 0
  37.  
  38. Parse Var item name '05'x path '05'x host '05'x port '05'x xtra
  39. Parse Var name 1 . 2 name       /*  discard type indicator byte  */
  40. Parse Var path 1 . 2 path       /*  discard type indicarot byte  */
  41. If name = "" Then name = args
  42.  
  43. /*  fetch fs. stem variable from GlobalVs  */
  44. 'CALLPIPE COMMAND GLOBALV SELECT GOPHER LIST | DROP' ,
  45.         '| LOCATE 1-4 / FS./ | SPEC /=/ 1 2-* NEXT | VARLOAD'
  46. If rc ^= 0 Then Address "COMMAND" 'EXEC GOPCLINI'
  47. If ^Datatype(fs.tube,'X') Then fs.tube = ""
  48.  
  49. message.0 = 0
  50. command = ""
  51.  
  52. Select  /*  viewer  */
  53.     When viewer = ""         Then Call BUILT_IN
  54.     When viewer = "XEDIT"    Then Call XEDIT
  55.     When viewer = "BROWSE"   Then Call BROWSE
  56.     Otherwise                     Call ANYOTHER
  57.     /*
  58.         handle disk-full conditions!
  59.      */
  60.     End  /*  Select  viewer  */
  61. vrc = rc
  62.  
  63. 'CALLPIPE STEM MESSAGE. | *:'
  64.  
  65. Parse Upper Var command cmdverb .
  66. Address "COMMAND" 'GLOBALV SELECT GOPHER PUT' ,
  67.         'COMMAND CMDVERB'
  68.  
  69. Exit vrc
  70.  
  71.  
  72. /* ============================================================ BUILT_IN
  73.  */
  74. BUILT_IN:
  75.  
  76. /*  read the file from the preceding stage  */
  77. 'CALLPIPE *: | EXPAND | XLATE OUTPUT | XLATE *-* 00-3F 40 FF 40' ,
  78.         '| DEBLOCK FIXED' fs.scrcols + 1 '| STEM FILE.'
  79.  
  80. /*  display the file and process user's response  */
  81. row = 3;        col = 0
  82. ki = file.0;    kl = fs.scrrows - 5;    ko = 1
  83. needle = ""     /*  may be re-used within this context  */
  84.  
  85. 'CALLPIPE COMMAND XMITMSG 614 (APPLID GOP' ,
  86.         'NOCOMP NOHEADER | STEM HELP.'
  87.  
  88. 'CALLPIPE COMMAND XMITMSG 5 (APPLID GOP NOHEADER | VAR MORE'
  89.  
  90. Do Forever
  91.  
  92.     /*  write the program title line  */
  93.     wscreen = sba(0,-1) || field("BLUE","PROT") || sba(0,0) || progid ,
  94.                         || sba(0,fs.scrcols-Length(host)-1) || host
  95.  
  96.     /*  no SBA for status because it follows host immediately  */
  97.     If message.0 < 1 Then Do
  98.     wscreen = wscreen   || field("PROT") || Left(ko || '/' || ki, 11)
  99.     If ko + kl <= ki Then
  100.     wscreen = wscreen   || field("WHITE","HIGH","PROT") || more
  101.         End  /*  If  ..  Do  */
  102.  
  103.     /*  don't write status or name if they'll be overlaid  */
  104.     If message.0 < 2 Then
  105.     wscreen = wscreen   || sba(2,(fs.scrcols-Length(name))/2) ,
  106.                         || field("WHITE","PROT") || name
  107.  
  108.     /*  write as many message lines as needed  */
  109.     If message.0 > 0 Then Do
  110.         Do i = 1 to message.0
  111.             wscreen = wscreen || sba(i,-1) ,
  112.                 || field("RED","HIGH","PROT") || message.i
  113.             End  /*  Do  For  */
  114.         message.0 = 0
  115.         End  /*  If  ..  Do  */
  116.     /*  we should probably limit that count  */
  117.  
  118.     /*  write those PFkey settings  */
  119.     wscreen = wscreen   || sba(fs.scrrows-2,-1) ,
  120.                         || field("BLUE","PROT") ,
  121.                         || help.1 ,
  122.                         || sba(fs.scrrows-1,-1) ,
  123.                         || field("BLUE","PROT") ,
  124.                         || help.2
  125.  
  126.     i = 1; j = ko
  127.     Do While i <= kl & j <= ki
  128.  
  129. /*      'CALLPIPE VAR FILE.' || i '| XLATE OUTPUT' ,
  130.             '| XLATE *-* 00-3F 40 FF 40 | VAR _LINE'                  */
  131.  
  132.         wscreen = wscreen || sba(i+2,-1) || field("GREEN","PROT")
  133.         wscreen = wscreen || file.j
  134.         i = i + 1;  j = j + 1
  135.         End
  136.  
  137.     rscreen = write_read(wscreen || sba(row,col) || '13'x)
  138.     Parse Var rscreen 1 aid 2 offset . '11'x rscreen
  139.     offset = fix(offset)
  140.     row = offset % fs.scrcols; col = offset // fs.scrcols
  141.  
  142.     /*  keep the  row/col  values within bounds  */
  143.     row = 3     /* just reset it */
  144.     col = 0     /* just reset it */
  145.  
  146.     Select /* aid */
  147.         When  aid = '7D'x   /* enter */ Then nop
  148.         When  aid = 'F2'x   /*  PF2  */ | ,
  149.               aid = 'C2'x   /*  PF14 */ | ,
  150.               aid = '7B'x   /*  PF11 */ | ,
  151.               aid = '4B'x   /*  PF23 */ Then Call SUBXEDIT
  152.         When  aid = 'F3'x   /*  PF3  */ | ,
  153.               aid = 'C3'x   /*  PF15 */ Then Leave
  154.         When  aid = 'F4'x   /*  PF4  */ | ,
  155.               aid = 'C4'x   /*  PF16 */ Then Call PRINT
  156.         When  aid = 'F5'x   /*  PF5  */ | ,
  157.               aid = 'C5'x   /*  PF17 */ Then Call SAVE
  158.         When  aid = 'F6'x   /*  PF6  */ | ,
  159.               aid = 'C6'x   /*  PF18 */ Then Call FIND
  160.         When  aid = 'F7'x   /*  PF7  */ | ,
  161.               aid = 'C7'x   /*  PF19 */ Then ko = Max(ko-kl+1,1)
  162.         When  aid = 'F8'x   /*  PF8  */ | ,
  163.               aid = 'C8'x   /*  PF20 */ Then ko = Min(ko+kl-1,ki)
  164.         When  aid = 'F9'x   /*  PF9  */ | ,
  165.               aid = 'C9'x   /*  PF21 */ Then  Call  MARK
  166.         When  aid = '7A'x   /*  PF10 */ | ,
  167.               aid = '4A'x   /*  PF22 */ Then  Call  BOOKLIST
  168.         When  aid = '6D'x   /* clear */ | ,
  169.               aid = '6E'x   /*  PA2  */ Then Do
  170.             row = 3; col = 0; ko = 1
  171.             End  /*  When ..  Do  */
  172.         When  aid = '7C'x   /*  PF12 */ | ,
  173.               aid = '4C'x   /*  PF24 */ | ,
  174.               aid = 'F0'x   /* sysrq */ | ,
  175.               aid = '6C'x   /*  PA1  */ Then  quit = 1
  176.         When  aid = 'F1'x   /*  PF1  */ | ,
  177.               aid = 'C1'x   /*  PF13 */ Then  Call  HELP
  178.         When  aid = '00'x               Then Do
  179.             /*  I/O error on screen  */
  180.             'CALLPIPE COMMAND XMITMSG 925 (APPLID GOP' ,
  181.                     'CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
  182.               Leave
  183.               End
  184.         Otherwise  Do   /*  Undefined PFkey/PAkey  */
  185.             'CALLPIPE COMMAND XMITMSG 657 "' || c2x(aid) || '"' ,
  186.                 '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
  187.             End  /*  Otherwise  Do  */
  188.         End  /*  Select  aid  */
  189.  
  190.     If quit Then Leave
  191.  
  192.     End  /*  Do  Forever  */
  193.  
  194. If quit Then command = "QUIT"
  195.  
  196. Return
  197.  
  198.  
  199.  
  200. /* =============================================================== XEDIT
  201.  *  Take the "file" from the input stream and pass it to CMS XEDIT.
  202.  */
  203. XEDIT:
  204.  
  205. If fs.tube ^= "" Then Do
  206.     /*  "Can't run XEDIT on this terminal."  */
  207.     'CALLPIPE COMMAND XMITMSG 512 "XEDIT"' ,
  208.             '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
  209.     Return
  210.     End /* If .. Do */
  211.  
  212. /*  stash this in a temporary file  */
  213. 'CALLPIPE *: | > VMGOPHER DOCUMENT A3'
  214.  
  215. /*  what's the real name of the file?  */
  216. Parse Value gopclifi(path) With fn ft .
  217. Push "COMMAND SET FNAME" fn
  218. Push "COMMAND SET FTYPE" ft
  219. Push "COMMAND SET FMODE A1"
  220.  
  221. /*  now invoke XEDIT  */
  222. 'CALLPIPE COMMAND STATE GOPXEDPR XEDIT *'
  223. If rc = 0 Then Address "COMMAND" ,
  224.                 'XEDIT VMGOPHER DOCUMENT A (PROFILE GOPXEDPR'
  225.           Else Address "COMMAND" ,
  226.                 'XEDIT VMGOPHER DOCUMENT A'
  227.  
  228. Return
  229.  
  230.  
  231.  
  232. /* ============================================================== BROWSE
  233.  *  Take the "file" from the input stream and pass it to CMS BROWSE.
  234.  */
  235. BROWSE:
  236.  
  237. If fs.tube ^= "" Then Do
  238.     /*  "Can't run BROWSE on this terminal."  */
  239.     'CALLPIPE COMMAND XMITMSG 512 "BROWSE"' ,
  240.             '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
  241.     Return
  242.     End /* If .. Do */
  243.  
  244. Parse Value gopclifi(path) With fn ft .
  245. filespec = fn ft 'A'
  246.  
  247. 'CALLPIPE CMS STATE' filespec '| STEM MESSAGE.'
  248. If  rc ^= 0 & rc ^= 28 & rc ^= 20  Then Return
  249. If  rc = 0 | rc = 20  Then Do
  250.     fn = "VMGOPHER"
  251.     ft = "DOCUMENT"
  252.     End  /*  If  ..  Do  */
  253. message.0 = 0
  254.  
  255. /*  stash this in a temporary file  */
  256. 'CALLPIPE *: | >' fn ft 'A3'
  257.  
  258. /* stash this in a temporary file and invoke BROWSE */
  259. Address "COMMAND" 'BROWSE' filespec
  260.  
  261. Return
  262.  
  263.  
  264.  
  265. /* ============================================================ ANYOTHER
  266.  *  View the file with some unknown text editor or file browser.
  267.  */
  268. ANYOTHER:
  269.  
  270. If fs.tube ^= "" Then Do
  271.     /*  "Can't run" viewer "on this terminal."  */
  272.     'CALLPIPE COMMAND XMITMSG 512 VIEWER' ,
  273.             '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
  274.     Return
  275.     End /* If .. Do */
  276.  
  277. Parse Value gopclifi(path) With fn ft .
  278. filespec = fn ft 'A'
  279.  
  280. 'CALLPIPE CMS STATE' filespec '| STEM MESSAGE.'
  281. If  rc ^= 0 & rc ^= 28 & rc ^= 20  Then Return
  282. If  rc = 0 | rc = 20  Then Do
  283.     fn = "VMGOPHER"
  284.     ft = "DOCUMENT"
  285.     End  /*  If  ..  Do  */
  286. message.0 = 0
  287.  
  288. /*  stash this in a temporary file  */
  289. 'CALLPIPE *: | >' fn ft 'A3'
  290.  
  291. /* stash this in a temporary file and invoke the viewer  */
  292. 'CALLPIPE CMS' viewer filespec '| CONSOLE'
  293.  
  294. Return
  295.  
  296.  
  297.  
  298. /* ---------------------------------------------------------------- HELP
  299.  * Invoke CMS HELP passing any supplied argument (context sensitive).
  300.  */
  301. HELP:     Procedure Expose fs. message.
  302.  
  303. If fs.tube ^= "" Then
  304.     'CALLPIPE COMMAND HELP GOPHER VIEWER (ALL' ,
  305.         '| GOPCLIFV VIEWER HELP' ,
  306.             '| STEM MESSAGE. APPEND'
  307.  
  308. Else Do
  309.     'CALLPIPE COMMAND HELP GOPHER VIEWER'
  310.     Address "COMMAND" 'VMFCLEAR'
  311.     End  /*  Else  Do  */
  312.  
  313. Return
  314.  
  315.  
  316.  
  317. /* ------------------------------------------------------------ SUBXEDIT
  318.  *  Take the file in storage and pass it to CMS XEDIT.
  319.  */
  320. SUBXEDIT:
  321.  
  322. If fs.tube ^= "" Then Do
  323.     /*  "Can't run XEDIT on this terminal."  */
  324.     'CALLPIPE COMMAND XMITMSG 512 "XEDIT"' ,
  325.             '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
  326.     Return
  327.     End /* If .. Do */
  328.  
  329. /*  stash this in a temporary file  */
  330. 'CALLPIPE STEM FILE. | > VMGOPHER DOCUMENT A3'
  331.  
  332. /*  what's the real name of the file?  */
  333. Parse Value gopclifi(path) With fn ft .
  334. Push "COMMAND SET FNAME" fn
  335. Push "COMMAND SET FTYPE" ft
  336. Push "COMMAND SET FMODE A1"
  337.  
  338. /*  now invoke XEDIT  */
  339. 'CALLPIPE COMMAND STATE GOPXEDPR XEDIT *'
  340. If rc = 0 Then Address "COMMAND" ,
  341.                 'XEDIT VMGOPHER DOCUMENT A (PROFILE GOPXEDPR'
  342.           Else Address "COMMAND" ,
  343.                 'XEDIT VMGOPHER DOCUMENT A'
  344.  
  345. Return
  346.  
  347.  
  348.  
  349. /* --------------------------------------------------------------- PRINT
  350.  *  Take the current "file" in context and send it to the user's
  351.  *  virtual printer.  Printer may be SPOOLed CONTinuous.
  352.  */
  353. PRINT:
  354.  
  355. If fs.tube ^= "" Then Do
  356.     /*  "Can't PRINT from this terminal."  */
  357.     'CALLPIPE COMMAND XMITMSG 507 (APPLID GOP CALLER FVW ERRMSG' ,
  358.             '| STEM MESSAGE. APPEND'
  359.     Return
  360.     End /* If .. Do */
  361.  
  362. 'CALLPIPE STEM FILE. | PRINT (TITLE' name '| STEM MESSAGE. APPEND'
  363.  
  364. Return
  365.  
  366.  
  367.  
  368. /* ---------------------------------------------------------------- SAVE
  369.  * Save the current file being viewed to the user's A disk.
  370.  */
  371. SAVE:
  372.  
  373. If fs.tube ^= "" Then Do
  374.     Call MESSAGE "Can't SAVE files via this terminal."
  375.     Return
  376.     End /* If .. Do */
  377.  
  378. Parse Value gopclifi(path) With fn ft .
  379. filespec = fn ft 'A'
  380.  
  381. 'CALLPIPE CMS STATE' filespec '| STEM MESSAGE.'
  382. If rc = 0 Then Do
  383.     'CALLPIPE COMMAND XMITMSG 24 FILESPEC' ,
  384.         '| SPLIT AT /;/ | TAKE | STEM MESSAGE.'
  385.     Return
  386.     End  /*  If  ..  Do  */
  387. If rc ^= 28 Then Return
  388. message.0 = 0
  389.  
  390. 'CALLPIPE STEM FILE. | >' filespec
  391. If rc = 0 Then Do
  392.     /*  Creating new file:  */
  393.     'CALLPIPE COMMAND XMITMSG 571 | STEM MESSAGE. APPEND'
  394.     message.1 = message.1 filespec
  395. /*  Call message "Created" filespec "from" path  */
  396.     End  /*  If  ..  Do  */
  397.  
  398. Return
  399.  
  400.  
  401.  
  402. /* ---------------------------------------------------------------- FIND
  403.  *  Find a particular string within the file being viewed.
  404.  */
  405. FIND:
  406.  
  407. 'CALLPIPE COMMAND XMITMSG 602 "' || needle || '" (APPLID GOP' ,
  408.         'CALLER MNU NOHEADER | GOPCLIUI | VAR NEEDLE'
  409. needle = Translate(Strip(needle))
  410. If needle = "" Then Return
  411.  
  412. Do i = ko + 1 to ki
  413.     If Index(Translate(file.i),needle) > 0 Then Do
  414.         ko = i
  415.         Return
  416.         End  /*  If  ..  Do  */
  417.     End  /*  Do  For  */
  418.  
  419. /*  'CALLPIPE COMMAND XMITMSG 546 (ERRMSG'  CALLER DMS is OK  */
  420. /*  "Target not found"  */
  421. 'CALLPIPE COMMAND XMITMSG 546 (APPLID GOP CALLER MNU ERRMSG' ,
  422.         '| STEM MESSAGE. APPEND'
  423.  
  424. Return
  425.  
  426.  
  427.  
  428.  
  429. /* ---------------------------------------------------------------- MARK
  430.  *  Save a book mark referencing this file.
  431.  */
  432. MARK:
  433.  
  434. If fs.tube ^= "" Then Do
  435.     /*  "Can't set bookmarks from this screen."  */
  436.     'CALLPIPE COMMAND XMITMSG 43 (APPLID GOP CALLER FVW ERRMSG' ,
  437.             '| STEM MESSAGE. APPEND'
  438.     Return
  439.     End /* If .. Do */
  440.  
  441. Address "COMMAND" 'GLOBALV SELECT GOPHER GET BOOKMARK.0'
  442. If ^Datatype(bookmark.0,'N') Then bookmark.0 = 0
  443. i = bookmark.0 + 1
  444. bookmark.i = item
  445. Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.' || i
  446. bookmark.0 = i
  447. Address "COMMAND" 'GLOBALV SELECT GOPHER PUTP BOOKMARK.0'
  448.  
  449. If rc = 0 Then 'CALLPIPE COMMAND XMITMSG 41 I' ,
  450.     '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
  451.     /*  "Bookmark" i "saved."  */
  452.           Else 'CALLPIPE COMMAND XMITMSG 514 RC "GLOBALV"' ,
  453.         '(APPLID GOP CALLER FVW ERRMSG | STEM MESSAGE. APPEND'
  454.  
  455. Return
  456.  
  457.  
  458.  
  459. /* ------------------------------------------------------------ BOOKLIST
  460.  *  Call GOPCLI to show the lit of bookmarks.
  461.  */
  462. BOOKLIST:
  463.  
  464. Address "CMS" 'GOPCLI (BOOKLIST'
  465.  
  466. Return
  467.  
  468.  
  469.  
  470. /* ----------------------------------------------------------------- FIX
  471.  * Takes an inbound 3270 DS screen address (two bytes)
  472.  * and returns the equivalent byte offset in decimal.
  473.  */
  474. FIX:
  475. Parse Arg o,.
  476. Parse Var o 1 o1 2 o2 3 .
  477. o1 = c2d(o1)
  478. o2 = c2d(o2)
  479. If o1 < 64 Then Return o1 * 256 + o2
  480.            Else Return (o1 // 64) * 64 + (o2 // 64)
  481.  
  482.  
  483.  
  484. /* ---------------------------------------------------------- WRITE_READ
  485.  * Display what we have, then wait for user input and return it.
  486.  */
  487. WRITE_READ: Procedure Expose fs.
  488. Parse Arg ws,wcc,wrt,.
  489. If wcc = "" Then wcc = 'C3'x
  490. /*  If wrt = "" Then wrt = 'C0'x  */
  491. If wrt = "" Then wrt = fs.write
  492. ws = wrt || wcc || ws
  493. 'CALLPIPE VAR WS | FULLSCR' fs.tube '| VAR RS'
  494. If rc ^= 0 Then rs = '000000'x
  495. Return rs
  496.  
  497.  
  498.  
  499. /* ----------------------------------------------------------------- SBA
  500.  * (a better SBA function extracted from PIPEDEMO; thanks, Chuck!)
  501.  * Construct Set Buffer Address order from row and column.
  502.  */
  503.  
  504. SBA:      Procedure Expose fs.
  505.  
  506. arg row , col, .
  507. row = Trunc(row)
  508. col = Trunc(col)
  509.  
  510. /*-----------------------------------------------------------------*/
  511. /* Calculate binary address.                                       */
  512. /*-----------------------------------------------------------------*/
  513.  
  514. offset = row * fs.scrcols + col
  515. Do While offset < 0; offset = offset + fs.scrrows * fs.scrcols; End
  516.  
  517. if fs.14bit then return '11'x || d2c(offset,2)
  518.  
  519. /*-----------------------------------------------------------------*/
  520. /* Convert to six-bit format. (xxxx111111111111 -> 0011111100111111*/
  521. /*-----------------------------------------------------------------*/
  522.  
  523. 'CALLPIPE var offset'               ,   /* Start with char number.    */
  524.     '| spec 1-* d2c 1.2 right'      ,   /* Convert to binary.         */
  525.     '| spec 1-* c2b 1'              ,   /* Convert to bit string.     */
  526.     '| spec /00/ 1  5.6  3'         ,   /* Place first six bits.      */
  527.            '/00/ 9 11.6 11'         ,   /* Place second six bits.     */
  528.     '| spec 1-* b2c 1'              ,   /* Convert back to binary.    */
  529.     '| xlate *-* 00-3F 40-7F'       ,   /* Translate to coded         */
  530.                 '01-09 C1-C9'       ,   /*   buffer address.          */
  531.                 '11-19 D1-D9'       ,   /*                            */
  532.                 '22-29 E2-E9'       ,   /*                            */
  533.                 '30-39 F0-F9'       ,   /*                            */
  534.     '| spec x11 1 1.2 2'            ,   /* Prefix with SBA order.     */
  535.     '| var offset'                      /* Put back in variable.      */
  536.  
  537. Return offset
  538.  
  539.  
  540.  
  541. /* --------------------------------------------------------------- FIELD
  542.  * Generate the 3270 DS sequence for extended field attributes
  543.  * (if available).
  544.  */
  545. FIELD:    Procedure Expose fs.
  546. a = '00'x
  547. b = '00'x
  548. c = 'F1'x
  549. i = 1
  550. Do While Arg(i) ^= ""
  551.     Select  /*  at  */
  552.         When Abbrev("PROTECTED",Arg(i),2)   Then a = bitor(a,'20'x)
  553.         When Abbrev("SKIP",Arg(i),1)        Then a = bitor(a,'10'x)
  554.         When Abbrev("NODISPLAY",Arg(i),1)   Then a = bitor(a,'0C'x)
  555.         When Abbrev("HIGH",Arg(i),1)        Then a = bitor(a,'08'x)
  556.         When Abbrev("BLINK",Arg(i),3)       Then b = bitor(b,'01'x)
  557.         When Abbrev("REVERSE",Arg(i),3)     Then b = bitor(b,'02'x)
  558.         When Abbrev("UNDERLINE",Arg(i),1)   Then b = bitor(b,'04'x)
  559.         When Abbrev("BLUE",Arg(i),3)        Then c = 'F1'x
  560.         When Abbrev("RED",Arg(i),3)         Then c = 'F2'x
  561.         When Abbrev("PINK",Arg(i),1)        Then c = 'F3'x
  562.         When Abbrev("GREEN",Arg(i),1)       Then c = 'F4'x
  563.         When Abbrev("TURQUOISE",Arg(i),1)   Then c = 'F5'x
  564.         When Abbrev("YELLOW",Arg(i),1)      Then c = 'F6'x
  565.         When Abbrev("WHITE",Arg(i),1)       Then c = 'F7'x
  566.         Otherwise nop
  567.         End  /*  Select  at  */
  568.     i = i + 1
  569.     End  /*  Do  While  */
  570.  
  571. If  ^fs.color   | ,
  572.     ^fs.exthi   Then    Return '1D'x || bitor(a,'40'x)
  573.                 Else    Return '2902'x || ,
  574.                                'C0'x   || bitor(a,'40'x) || ,
  575.                                '42'x   || bitor(c,'40'x)
  576.  
  577.